home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1998 August / PC Plus SuperCD 50b Issue 142 (CD142b) (August 1998).iso / full / nt / MSSql / I386 / sqlx86.exe / PTK / SAMPLES / SQLDMO / VB / EXPLORE / EXPLORE.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-04-03  |  12.7 KB  |  421 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "SQL-DMO Explorer"
  4.    ClientHeight    =   6705
  5.    ClientLeft      =   180
  6.    ClientTop       =   390
  7.    ClientWidth     =   9240
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   1
  11.       weight          =   700
  12.       size            =   8.25
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    Height          =   7110
  18.    Left            =   120
  19.    LinkTopic       =   "Form1"
  20.    ScaleHeight     =   6705
  21.    ScaleWidth      =   9240
  22.    Top             =   45
  23.    Width           =   9360
  24.    Begin VB.TextBox txtProperties 
  25.       Height          =   2535
  26.       Left            =   120
  27.       MultiLine       =   -1  'True
  28.       ScrollBars      =   3  'Both
  29.       TabIndex        =   13
  30.       Top             =   4080
  31.       Width           =   9015
  32.    End
  33.    Begin VB.CommandButton cmdExit 
  34.       Caption         =   "E&xit"
  35.       Height          =   375
  36.       Left            =   8640
  37.       TabIndex        =   4
  38.       Top             =   120
  39.       Width           =   495
  40.    End
  41.    Begin VB.ComboBox cboFour 
  42.       Height          =   315
  43.       Left            =   6960
  44.       Sorted          =   -1  'True
  45.       Style           =   2  'Dropdown List
  46.       TabIndex        =   11
  47.       Top             =   600
  48.       Width           =   2175
  49.    End
  50.    Begin VB.ListBox lstFour 
  51.       Height          =   2985
  52.       Left            =   6960
  53.       Sorted          =   -1  'True
  54.       TabIndex        =   12
  55.       Top             =   960
  56.       Width           =   2175
  57.    End
  58.    Begin VB.CommandButton cmdConnect 
  59.       Caption         =   "&Connect"
  60.       Height          =   375
  61.       Left            =   7560
  62.       TabIndex        =   3
  63.       Top             =   120
  64.       Width           =   975
  65.    End
  66.    Begin VB.TextBox txtPassword 
  67.       Height          =   285
  68.       Left            =   5880
  69.       PasswordChar    =   "*"
  70.       TabIndex        =   2
  71.       Top             =   120
  72.       Width           =   1455
  73.    End
  74.    Begin VB.TextBox txtLogin 
  75.       Height          =   285
  76.       Left            =   3360
  77.       TabIndex        =   1
  78.       Top             =   120
  79.       Width           =   1455
  80.    End
  81.    Begin VB.TextBox txtServer 
  82.       Height          =   285
  83.       Left            =   1200
  84.       TabIndex        =   0
  85.       Top             =   120
  86.       Width           =   1455
  87.    End
  88.    Begin VB.ListBox lstThree 
  89.       Height          =   2985
  90.       Left            =   4680
  91.       Sorted          =   -1  'True
  92.       TabIndex        =   10
  93.       Top             =   960
  94.       Width           =   2175
  95.    End
  96.    Begin VB.ListBox lstTwo 
  97.       Height          =   2985
  98.       Left            =   2400
  99.       Sorted          =   -1  'True
  100.       TabIndex        =   8
  101.       Top             =   960
  102.       Width           =   2175
  103.    End
  104.    Begin VB.ListBox lstOne 
  105.       Height          =   2985
  106.       Left            =   120
  107.       Sorted          =   -1  'True
  108.       TabIndex        =   6
  109.       Top             =   960
  110.       Width           =   2175
  111.    End
  112.    Begin VB.ComboBox cboThree 
  113.       Height          =   315
  114.       Left            =   4680
  115.       Sorted          =   -1  'True
  116.       Style           =   2  'Dropdown List
  117.       TabIndex        =   9
  118.       Top             =   600
  119.       Width           =   2175
  120.    End
  121.    Begin VB.ComboBox cboTwo 
  122.       Height          =   315
  123.       Left            =   2400
  124.       Sorted          =   -1  'True
  125.       Style           =   2  'Dropdown List
  126.       TabIndex        =   7
  127.       Top             =   600
  128.       Width           =   2175
  129.    End
  130.    Begin VB.ComboBox cboOne 
  131.       Height          =   315
  132.       Left            =   120
  133.       Sorted          =   -1  'True
  134.       Style           =   2  'Dropdown List
  135.       TabIndex        =   5
  136.       Top             =   600
  137.       Width           =   2175
  138.    End
  139.    Begin VB.Label lblPassword 
  140.       Caption         =   "Password:"
  141.       Height          =   255
  142.       Left            =   4920
  143.       TabIndex        =   16
  144.       Top             =   120
  145.       Width           =   855
  146.    End
  147.    Begin VB.Label lblLogin 
  148.       Caption         =   "Login:"
  149.       Height          =   255
  150.       Left            =   2760
  151.       TabIndex        =   15
  152.       Top             =   120
  153.       Width           =   615
  154.    End
  155.    Begin VB.Label lblServer 
  156.       Caption         =   "SQL Server:"
  157.       Height          =   255
  158.       Left            =   120
  159.       TabIndex        =   14
  160.       Top             =   120
  161.       Width           =   1095
  162.    End
  163. Attribute VB_Name = "frmMain"
  164. Attribute VB_Creatable = False
  165. Attribute VB_Exposed = False
  166. Option Explicit
  167. Private Sub FillProperties(oObject As Object, txtText As Object)
  168.     On Error Resume Next
  169.     Dim oProperty As Object
  170.     frmMain.MousePointer = 11
  171.     With txtText
  172.         Select Case oObject.TypeOf
  173.         Case SQLOLEObj_Subscription
  174.             .Text = "Properties for " & oObject.ServerName & NL
  175.         Case Else
  176.             .Text = "Properties for " & oObject.Name & NL
  177.         End Select
  178.         For Each oProperty In oObject.Properties
  179.             .Text = .Text & oProperty.Name & ": " & oProperty.Value & NL
  180.         Next
  181.     End With
  182.     frmMain.MousePointer = 0
  183. End Sub
  184. Private Sub cboFour_Click()
  185.     If oCurrentThree Is Nothing Then Exit Sub
  186.     FillFour
  187. End Sub
  188. Private Sub cboOne_Click()
  189.     cboTwo.Clear
  190.     lstTwo.Clear
  191.     cboThree.Clear
  192.     lstThree.Clear
  193.     cboFour.Clear
  194.     lstFour.Clear
  195.     Set oCurrentOne = Nothing
  196.     Select Case cboOne.Text
  197.     Case "Databases"
  198.         cboTwo.AddItem "Defaults"
  199.         cboTwo.AddItem "Groups"
  200.         cboTwo.AddItem "Publications"
  201.         cboTwo.AddItem "Rules"
  202.         cboTwo.AddItem "StoredProcedures"
  203.         cboTwo.AddItem "SystemDataTypes"
  204.         cboTwo.AddItem "Tables"
  205.         cboTwo.AddItem "UserDefinedDataTypes"
  206.         cboTwo.AddItem "Users"
  207.         cboTwo.AddItem "Views"
  208.     Case "RemoteServers"
  209.         cboTwo.AddItem "RemoteLogins"
  210.     End Select
  211.     FillOne
  212. End Sub
  213. Private Sub cboThree_Click()
  214.     cboFour.Clear
  215.     lstFour.Clear
  216.     Set oCurrentThree = Nothing
  217.     Select Case cboThree.Text
  218.     Case "Articles"
  219.         cboFour.AddItem "Subscriptions"
  220.     End Select
  221.     If oCurrentTwo Is Nothing Then Exit Sub
  222.     FillThree
  223. End Sub
  224. Private Sub cboTwo_Click()
  225.     cboThree.Clear
  226.     lstThree.Clear
  227.     cboFour.Clear
  228.     lstFour.Clear
  229.     Set oCurrentTwo = Nothing
  230.     Select Case cboTwo.Text
  231.     Case "Tables"
  232.         cboThree.AddItem "Checks"
  233.         cboThree.AddItem "Columns"
  234.         cboThree.AddItem "Indexes"
  235.         cboThree.AddItem "Keys"
  236.         cboThree.AddItem "Triggers"
  237.     Case "Publications"
  238.         cboThree.AddItem "Articles"
  239.     End Select
  240.     If oCurrentOne Is Nothing Then Exit Sub
  241.     FillTwo
  242. End Sub
  243. Private Sub FillOne()
  244.     On Error Resume Next
  245.     lstOne.Clear
  246.     If cboOne.ListIndex = -1 Then Exit Sub
  247.     ReDim oCollection(0) As Object
  248.     GetCollection oSQLServer, (cboOne.Text), oCollection()
  249.     Dim i As Integer
  250.     For i = 1 To oCollection(0).Count
  251.         lstOne.AddItem oCollection(0)(i).Name
  252.     Next i
  253. End Sub
  254. Private Sub FillThree()
  255.     On Error Resume Next
  256.     lstThree.Clear
  257.     If cboThree.ListIndex = -1 Then Exit Sub
  258.     ReDim oCollection(0) As Object
  259.     GetCollection oCurrentTwo, (cboThree.Text), oCollection()
  260.     Dim i As Integer
  261.     For i = 1 To oCollection(0).Count
  262.         lstThree.AddItem oCollection(0)(i).Name
  263.     Next i
  264. End Sub
  265. Private Sub FillFour()
  266.     On Error Resume Next
  267.     lstFour.Clear
  268.     If cboFour.ListIndex = -1 Then Exit Sub
  269.     ReDim oCollection(0) As Object
  270.     GetCollection oCurrentThree, (cboFour.Text), oCollection()
  271.     Dim i As Integer
  272.     For i = 1 To oCollection(0).Count
  273.     Select Case oCollection(0)(i).TypeOf
  274.     Case SQLOLEObj_Subscription
  275.         lstFour.AddItem oCollection(0)(i).ServerName
  276.     Case Else
  277.         lstFour.AddItem oCollection(0)(i).Name
  278.     End Select
  279.     Next i
  280. End Sub
  281. Private Sub FillTwo()
  282.     On Error Resume Next
  283.     lstTwo.Clear
  284.     If cboTwo.ListIndex = -1 Then Exit Sub
  285.     ReDim oCollection(0) As Object
  286.     GetCollection oCurrentOne, (cboTwo.Text), oCollection()
  287.     Dim i As Integer
  288.     For i = 1 To oCollection(0).Count
  289.         lstTwo.AddItem oCollection(0)(i).Name
  290.     Next i
  291. End Sub
  292. Private Sub cmdConnect_Click()
  293.     On Error Resume Next
  294.         
  295.     frmMain.MousePointer = 11
  296.     oSQLServer.DisConnect
  297.     oSQLServer.Connect txtServer.Text, txtLogin.Text, txtPassword.Text
  298.     With txtProperties
  299.         If Err.Number = 0 Then
  300.             .Text = "Properties for SQL Server " & oSQLServer.TrueName & NL
  301.             FillProperties oSQLServer, txtProperties
  302.         Else
  303.             .Text = Err.Source & " Error " & Err.Number - vbObjectError & ":" & NL
  304.             .Text = .Text & "    " & Err.Description
  305.         End If
  306.     End With
  307.     frmMain.MousePointer = 0
  308.         
  309.     lstOne.Clear
  310.     lstTwo.Clear
  311.     lstThree.Clear
  312.     lstFour.Clear
  313. End Sub
  314. Private Sub cmdExit_Click()
  315.     Unload frmMain
  316. End Sub
  317. Private Sub Form_Load()
  318.     On Error Resume Next
  319.     NL = Chr$(13) & Chr$(10)
  320.     Set oSQLServer = New SQLOLE.SQLServer
  321.     oSQLServer.LoginTimeout = 10
  322.     With cboOne
  323.         .Clear
  324.         .AddItem "Alerts"
  325.         .AddItem "Databases"
  326.         .AddItem "Devices"
  327.         .AddItem "Languages"
  328.         .AddItem "Logins"
  329.         .AddItem "Operators"
  330.         .AddItem "RemoteServers"
  331.     End With
  332. End Sub
  333. Private Sub Form_Unload(Cancel As Integer)
  334.     On Error Resume Next
  335.     oSQLServer.DisConnect
  336.     oSQLServer.Close
  337. End Sub
  338. Private Sub lstFour_Click()
  339.     On Error Resume Next
  340.     Select Case cboFour.Text
  341.     Case "Subscriptions"
  342.         Set oCurrentFour = oCurrentThree.Subscriptions(lstFour.Text)
  343.     End Select
  344.     FillProperties oCurrentFour, txtProperties
  345. End Sub
  346. Private Sub lstOne_Click()
  347.     On Error Resume Next
  348.     Select Case cboOne.Text
  349.     Case "Databases"
  350.         Set oCurrentOne = oSQLServer.Databases(lstOne.Text)
  351.     Case "Devices"
  352.         Set oCurrentOne = oSQLServer.Devices(lstOne.Text)
  353.     Case "Languages"
  354.         Set oCurrentOne = oSQLServer.Languages(lstOne.Text)
  355.     Case "Logins"
  356.         Set oCurrentOne = oSQLServer.Logins(lstOne.Text)
  357.     Case "RemoteServers"
  358.         Set oCurrentOne = oSQLServer.RemoteServers(lstOne.Text)
  359.     Case "Alerts"
  360.         Set oCurrentOne = oSQLServer.Alerts(lstOne.Text)
  361.     Case "Operators"
  362.         Set oCurrentOne = oSQLServer.Operators(lstOne.Text)
  363.     End Select
  364.     lstTwo.Clear
  365.     lstThree.Clear
  366.     lstFour.Clear
  367.     FillTwo
  368.     FillProperties oCurrentOne, txtProperties
  369. End Sub
  370. Private Sub lstThree_Click()
  371.     On Error Resume Next
  372.     Select Case cboThree.Text
  373.     Case "Columns"
  374.         Set oCurrentThree = oCurrentTwo.Columns(lstThree.Text)
  375.     Case "Indexes"
  376.         Set oCurrentThree = oCurrentTwo.Indexes(lstThree.Text)
  377.     Case "Triggers"
  378.         Set oCurrentThree = oCurrentTwo.Triggers(lstThree.Text)
  379.     Case "Keys"
  380.         Set oCurrentThree = oCurrentTwo.Keys(lstThree.Text)
  381.     Case "Checks"
  382.         Set oCurrentThree = oCurrentTwo.Checks(lstThree.Text)
  383.     Case "Articles"
  384.         Set oCurrentThree = oCurrentTwo.Articles(lstThree.Text)
  385.     End Select
  386.     lstFour.Clear
  387.     FillFour
  388.     FillProperties oCurrentThree, txtProperties
  389. End Sub
  390. Private Sub lstTwo_Click()
  391.     On Error Resume Next
  392.     Select Case cboTwo.Text
  393.     Case "Defaults"
  394.         Set oCurrentTwo = oCurrentOne.Defaults(lstTwo.Text)
  395.     Case "Groups"
  396.         Set oCurrentTwo = oCurrentOne.Groups(lstTwo.Text)
  397.     Case "Rules"
  398.         Set oCurrentTwo = oCurrentOne.Rules(lstTwo.Text)
  399.     Case "StoredProcedures"
  400.         Set oCurrentTwo = oCurrentOne.StoredProcedures(lstTwo.Text)
  401.     Case "SystemDataTypes"
  402.         Set oCurrentTwo = oCurrentOne.SystemDatatypes(lstTwo.Text)
  403.     Case "Tables"
  404.         Set oCurrentTwo = oCurrentOne.Tables(lstTwo.Text)
  405.     Case "UserDefinedDataTypes"
  406.         Set oCurrentTwo = oCurrentOne.UserDefinedDatatypes(lstTwo.Text)
  407.     Case "Users"
  408.         Set oCurrentTwo = oCurrentOne.Users(lstTwo.Text)
  409.     Case "Views"
  410.         Set oCurrentTwo = oCurrentOne.Views(lstTwo.Text)
  411.     Case "RemoteLogins"
  412.         Set oCurrentTwo = oCurrentOne.RemoteLogins(lstTwo.Text)
  413.     Case "Publications"
  414.         Set oCurrentTwo = oCurrentOne.Publications(lstTwo.Text)
  415.     End Select
  416.     lstThree.Clear
  417.     lstFour.Clear
  418.     FillThree
  419.     FillProperties oCurrentTwo, txtProperties
  420. End Sub
  421.